home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / os2 / ftree10f.zip / ExGedcom.ftx < prev    next >
Text File  |  1996-05-25  |  6KB  |  223 lines
  1. /*
  2.    Family Tree Rexx Script FTX
  3.  
  4.    Copyright (C) 1996 by <Nils Meier>
  5.  
  6.    Please send comments to / Kommentar bitte an
  7.         meier2@athene.informatik.uni-bonn.de
  8.  
  9.    <This script exports the family tree to a GEDCOM file
  10.     / Dieses Skript exportiert den Stammbaum in eine GEDCOM Datei.>
  11. */
  12.  
  13. CALL RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'
  14.  
  15. /* ----------------------- Params  /  Parameter ------------------- */
  16. namewidth=30
  17.  
  18. datasex   = ' MW'
  19. datamonth = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
  20.  
  21. IF getLanguage()='Deutsch' THEN DO
  22.    header     = 'Exportiere nach GEDCOM:'
  23.    select     = 'GEDCOM-Export-Datei angeben:'
  24.    fileerror  = 'Fehler waehrend des Schreibens von : '
  25.    exporthead = 'Exportiere HEAD ...'
  26.    exportindis= 'Exportiere INDIs ...'
  27.    exportfams = 'Exportiere FAMs ...'
  28.    done       = 'Fertig !'
  29. END
  30. ELSE DO
  31.    header     = 'Exporting to GEDCOM:'
  32.    select     = 'Select GEDCOM file for export:'
  33.    fileerror  = 'Error during writing to : '
  34.    exporthead = 'Exporting HEAD ...'
  35.    exportindis= 'Exporting INDIs ...'
  36.    exportfams = 'Exporting FAMs ...'
  37.    done       = 'Done !'
  38. END
  39.  
  40. /* ----------------- Display Header / Kopf der Ausgabe ------------- */
  41. SAY(header||DATE())
  42. SAY('.............................................')
  43.  
  44.  
  45. /* ------------------- Open file  /  Datei oeffnen  ---------------- */ 
  46. filename=getFileName(select,'*.GED')
  47. IF filename='' THEN DO
  48.    SAY(done)
  49.    RETURN
  50.    END
  51.  
  52. rc=SysFileDelete(filename)
  53. rc=rc+LINEOUT(filename,,1)
  54. IF (rc=1) THEN DO
  55.    SAY(fileerror||filename)
  56.    RETURN
  57.    END
  58.  
  59. /* -------------- Header of GEDCOM  /  Kopf von GEDCOM -------------- */
  60.  
  61. SAY(exporthead)
  62.  
  63. rc=LINEOUT(filename,'0 HEAD')
  64. rc=LINEOUT(filename,'1 SOUR FamilyTree for OS/2 - ExGedcom.ftx')
  65. rc=LINEOUT(filename,'2 VERS 1.0f')
  66. rc=LINEOUT(filename,'1 CHAR IBMPC')
  67. rc=LINEOUT(filename,'1 FILE '||FILESPEC('name',filename))
  68. rc=LINEOUT(filename,'1 DATE '||DATE())
  69.  
  70. /* ------------ Export Persons  /  Personen exportieren -------------- */
  71.  
  72. SAY(exportindis)
  73.  
  74. rc=selectPerson('F')
  75. DO WHILE RC=1
  76.  
  77.    /* Personal Data  /  persoenliche Daten */
  78.  
  79.    rc=LINEOUT(filename,'0 @I'||getPID()||'@ INDI')
  80.    rc=LINEOUT(filename,'1 NAME '||getFirstName()||' /'||getName()||'/')
  81.    rc=LINEOUT(filename,'1 SEX '||SUBSTR(datasex,getSex()+1,1))
  82.    rc=LINEOUT(filename,'1 BIRT')
  83.    rc=LINEOUT(filename,'2 DATE '||calcDate(getBirthDate('D'),getBirthDate('M'),getBirthDate('Y')))
  84.    rc=LINEOUT(filename,'2 PLAC '||getBirthPlace())
  85.    rc=LINEOUT(filename,'1 DEAT')
  86.    rc=LINEOUT(filename,'2 DATE '||calcDate(getDeathDate('D'),getDeathDate('M'),getDeathDate('Y')))
  87.    rc=LINEOUT(filename,'2 PLAC '||getDeathPlace())
  88.  
  89.    temp=getPicture()
  90.    IF temp<>'' THEN
  91.      rc=LINEOUT(filename,'1 PHOT '||temp)
  92.  
  93.    temp=getOccupation()
  94.    IF temp<>'' THEN
  95.       rc=LINEOUT(filename,'1 OCCU '||temp)
  96.  
  97.    temp=getAddress()
  98.    tag='1 ADDR '
  99.    DO WHILE temp<>''
  100.       p=POS(',',temp)
  101.       IF p=0 THEN p=LENGTH(temp)+1
  102.       rc=LINEOUT(filename,tag||SUBSTR(temp,1,p-1))
  103.       temp=SUBSTR(temp,p+1)
  104.       tag='2 CONT '
  105.    END
  106.  
  107.    l=1
  108.    tag='1 NOTE '
  109.    DO FOREVER
  110.       temp=getMemo(l)
  111.       IF LENGTH(temp)=0 THEN LEAVE
  112.       rc=LINEOUT(filename,tag||temp)
  113.       tag='2 CONT '
  114.       l=l+1
  115.    END
  116.  
  117.    /* Families with partners  /  Familien mit Partnern */
  118.    f=1
  119.    DO FOREVER
  120.       rc=selectFamily(f)
  121.       IF rc=0 THEN LEAVE
  122.       rc=LINEOUT(filename,'1 FAMS @F'||getFID()||'@')
  123.       f=f+1
  124.    END
  125.  
  126.    /* Family of parents  /  Familie der Eltern */
  127.    rc=selectFamily('p')
  128.    IF rc=1 THEN
  129.       rc=LINEOUT(filename,'1 FAMC @F'||getFID()||'@')
  130.  
  131.    /* Next one / Naechster */
  132.    rc=selectPerson('N')
  133. END
  134.  
  135. /* ------------ Export Families  /  Familien exportieren -------------- */
  136.  
  137. SAY(exportfams)
  138.  
  139. rc=selectFamily('F')
  140. DO WHILE RC=1
  141.    /* Standard data  /  Standarddaten */
  142.  
  143.    rc=LINEOUT(filename,'0 @F'||getFID()||'@ FAM')
  144.  
  145.    rc=selectPerson('f')
  146.    rc=LINEOUT(filename,'1 HUSB '||'@I'||getPID()||'@')
  147.    rc=selectPerson('m')
  148.    rc=LINEOUT(filename,'1 WIFE '||'@I'||getPID()||'@')
  149.  
  150.    rc=LINEOUT(filename,'1 MARR')
  151.    rc=LINEOUT(filename,'2 DATE '||calcDate(getMarriageDate('D'),getMarriageDate('M'),getMarriageDate('Y')))
  152.    rc=LINEOUT(filename,'2 PLAC '||getMarriagePlace())
  153.  
  154.    rc=LINEOUT(filename,'1 DIV')
  155.    rc=LINEOUT(filename,'2 DATE '||calcDate(getDivorceDate('D'),getDivorceDate('M'),getDivorceDate('Y')))
  156.  
  157.    /* Children  /  Kinder */
  158.    c=1
  159.    DO FOREVER
  160.       rc=selectPerson(c)
  161.       IF rc=0 THEN LEAVE
  162.       rc=LINEOUT(filename,'1 CHIL @I'||getPID()||'@')
  163.       c=c+1
  164.    END
  165.  
  166.    /* Next one / Naechster */
  167.    rc=selectFamily('N')
  168. END
  169.  
  170. /* ------------------- Close File  /  Datei schliessen -------------- */
  171. rc=LINEOUT(filename,'0 TRLR')
  172. rc=LINEOUT(filename)
  173.  
  174. /* ------------------------ Done / Fertig ---------------------------*/
  175. SAY(done)
  176. RETURN
  177.  
  178.  
  179.  
  180. /* =============== Auxilary Functions / Hilfsfunktionen =============== */
  181.  
  182.  
  183. /* --------------- Calculate Date  /  Datum berechnen ---------------- */
  184. calcDate:
  185.    day=ARG(1)
  186.    month=ARG(2)
  187.    year=ARG(3)
  188.  
  189.  
  190.    /* --- dd.mm.yyyy -> 'dd mm yyyy' ---- */
  191.    IF (day>0)&(month>0)&(year>0) THEN
  192.       RETURN(day||' '||month||' '||year)
  193.  
  194.    /* --- ??.??.???? -> '' -------------- */
  195.    IF (day=0)&(month=0)&(year=0) THEN
  196.       RETURN('')
  197.  
  198.    /* --- ??.mm.yyyy -> 'MMM yyyy ------- */
  199.    IF (day=0)&(month>0)&(year>0) THEN
  200.       RETURN(WORD(datamonth,month)||' '||year)
  201.  
  202.    /* --- ??.??.yyyy -> 'yyyy' ---------- */
  203.    IF (day=0)&(month=0)&(year>0) THEN
  204.       RETURN(year)
  205.  
  206.    /* --- dd.mm.???? -> 'dd MMM' -------- */
  207.    IF (day>0)&(month>0)&(year=0) THEN
  208.       RETURN(day||' '||WORD(datamonth,month))
  209.  
  210.    /* --- ??.mm.???? -> 'MMM' ----------- */
  211.    IF (day=0)&(month>0)&(year=0) THEN
  212.       RETURN(WORD(datamonth,month))
  213.  
  214.    /* --- dd.??.yyyy -> 'yyyy' ---------- */
  215.    IF (day>0)&(month=0)&(year>0) THEN
  216.       RETURN(year)
  217.  
  218.    /* --- dd.??.???? -> ''--------------- */
  219.    RETURN('')
  220.  
  221.  
  222.  
  223.